actblue_contribs %>%
group_by(ga_candidate) %>%
summarise(total_dollars = sum(contribution_amount), avg_amount = mean(contribution_amount), median_amount = median(contribution_amount))
| ga_candidate | total_dollars | avg_amount | median_amount |
|---|---|---|---|
| OSSOFF | 55766107 | 46.81377 | 20.0 |
| WARNOCK | 58220850 | 45.15162 | 17.5 |
winred_contribs %>%
group_by(ga_candidate) %>%
summarise(total_dollars = sum(contribution_amount), avg_amount = mean(contribution_amount), median_amount = median(contribution_amount))
| ga_candidate | total_dollars | avg_amount | median_amount |
|---|---|---|---|
| LOEFFLER | 26995653 | 55.57657 | 25 |
| PERDUE | 28593871 | 59.58050 | 25 |
Dem overall totals
dem_inout <- actblue_contribs %>%
group_by(in_out_state) %>%
summarise(total_dollars = sum(contribution_amount)) %>%
mutate(
pct_of_total = round_half_up(total_dollars/sum(total_dollars)*100, 1)
) %>%
ungroup()
dem_inout
| in_out_state | total_dollars | pct_of_total |
|---|---|---|
| IN | 4423403 | 3.9 |
| OUT | 109563554 | 96.1 |
GOP overall totals
gop_inout <- winred_contribs %>%
group_by(in_out_state) %>%
summarise(total_dollars = sum(contribution_amount)) %>%
mutate(
pct_of_total = round_half_up(total_dollars/sum(total_dollars)*100, 1)
) %>%
ungroup()
gop_inout
| in_out_state | total_dollars | pct_of_total |
|---|---|---|
| IN | 4364619 | 7.9 |
| OUT | 51224906 | 92.1 |
Dem totals by top states
dem_bystate <- actblue_contribs %>%
group_by(contributor_state) %>%
summarise(total_dollars = sum(contribution_amount)) %>%
mutate(
pct_of_total = round_half_up(total_dollars/sum(total_dollars)*100, 1)
) %>%
arrange(desc(total_dollars)) %>%
ungroup() %>%
head(15)
dem_bystate
| contributor_state | total_dollars | pct_of_total |
|---|---|---|
| CA | 26310973 | 23.1 |
| NY | 10755274 | 9.4 |
| WA | 6201746 | 5.4 |
| MA | 6000091 | 5.3 |
| TX | 4955258 | 4.3 |
| FL | 4790404 | 4.2 |
| GA | 4423403 | 3.9 |
| IL | 4216143 | 3.7 |
| PA | 3607792 | 3.2 |
| MD | 3374599 | 3.0 |
| VA | 3305815 | 2.9 |
| CO | 3059633 | 2.7 |
| OR | 2947936 | 2.6 |
| NJ | 2846614 | 2.5 |
| NC | 2317830 | 2.0 |
Dem candidate totals
dem_inout_bycand <- actblue_contribs %>%
group_by(ga_candidate, in_out_state) %>%
summarise(total_dollars = sum(contribution_amount)) %>%
mutate(
pct_of_total = round_half_up(total_dollars/sum(total_dollars)*100, 1)
) %>%
ungroup()
dem_inout_bycand
| ga_candidate | in_out_state | total_dollars | pct_of_total |
|---|---|---|---|
| OSSOFF | IN | 1988232 | 3.6 |
| OSSOFF | OUT | 53777875 | 96.4 |
| WARNOCK | IN | 2435171 | 4.2 |
| WARNOCK | OUT | 55785679 | 95.8 |
#chart it out
d <- ggplot(dem_inout, aes(in_out_state, total_dollars)) + geom_col(fill = "darkblue") + coord_flip() +
theme_minimal()
#add extra elements to the chart and convert to ggplotly
d2 <- d + labs(title = "Dems: In vs. Out of State",
subtitle = "(Since Nov. 4th)",
caption = "Source: Bloomberg Analysis, FEC",
x ="", y = "") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.subtitle = element_text(hjust = 0.5)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_y_continuous(labels=dollar)
d2
# The palette:
cbPalette <- c("#508104","#db8200")
d <- ggplot(data = dem_inout_bycand, aes(x = ga_candidate, y = total_dollars, fill = in_out_state)) +
geom_col(position = "dodge") + coord_flip() + theme_minimal()
d2 <- d + labs(title="Dems Candidates: In vs. Out of State",
subtitle = "(Since Nov. 4th)",
caption = "Source: Source: Bloomberg Analysis, FEC",
x ="", y = "") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.subtitle = element_text(hjust = 0.5)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_y_continuous(labels=dollar) +
scale_fill_manual(values=cbPalette) +
theme(legend.title=element_blank())
d2
GOP totals by top states
gop_bystate <- winred_contribs %>%
group_by(contributor_state) %>%
summarise(total_dollars = sum(contribution_amount)) %>%
mutate(
pct_of_total = round_half_up(total_dollars/sum(total_dollars)*100, 1)
) %>%
arrange(desc(total_dollars)) %>%
ungroup() %>%
head(15)
gop_bystate
| contributor_state | total_dollars | pct_of_total |
|---|---|---|
| CA | 6776895 | 12.2 |
| TX | 6572833 | 11.8 |
| FL | 6460651 | 11.6 |
| GA | 4364619 | 7.9 |
| NY | 2479220 | 4.5 |
| VA | 1890726 | 3.4 |
| IL | 1650256 | 3.0 |
| AZ | 1547167 | 2.8 |
| PA | 1469174 | 2.6 |
| NC | 1389294 | 2.5 |
| CO | 1386772 | 2.5 |
| WA | 1329598 | 2.4 |
| OH | 1201732 | 2.2 |
| NJ | 1131895 | 2.0 |
| MI | 1090944 | 2.0 |
GOP candidate totals
gop_inout_bycand <- winred_contribs %>%
group_by(ga_candidate, in_out_state) %>%
summarise(total_dollars = sum(contribution_amount)) %>%
mutate(
pct_of_total = round_half_up(total_dollars/sum(total_dollars)*100, 1)
) %>%
ungroup()
gop_inout_bycand
| ga_candidate | in_out_state | total_dollars | pct_of_total |
|---|---|---|---|
| LOEFFLER | IN | 1981588 | 7.3 |
| LOEFFLER | OUT | 25014065 | 92.7 |
| PERDUE | IN | 2383031 | 8.3 |
| PERDUE | OUT | 26210841 | 91.7 |
#chart it out
d <- ggplot(gop_inout, aes(in_out_state, total_dollars)) + geom_col(fill = "darkred") + coord_flip() +
theme_minimal()
#add extra elements to the chart and convert to ggplotly
d2 <- d + labs(title = "Republicans: In vs. Out of State",
subtitle = "(Since Nov. 4th)",
caption = "Source: Bloomberg Analysis, FEC",
x ="", y = "") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.subtitle = element_text(hjust = 0.5)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_y_continuous(labels=dollar)
d2
# The palette:
cbPalette <- c("#508104","#db8200")
d <- ggplot(data = gop_inout_bycand, aes(x = ga_candidate, y = total_dollars, fill = in_out_state)) +
geom_col(position = "dodge") + coord_flip() + theme_minimal()
d2 <- d + labs(title="Republican Candidates: In vs. Out of State",
subtitle = "(Since Nov. 4th)",
caption = "Source: Source: Bloomberg Analysis, FEC",
x ="", y = "") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.subtitle = element_text(hjust = 0.5)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_y_continuous(labels=dollar) +
scale_fill_manual(values=cbPalette) +
theme(legend.title=element_blank())
d2
Top Zips for Democratic Total Contributions (ActBlue)
#pull out top 10 zips for the dems
dem10 <- zipcompare %>%
arrange(desc(demtotal)) %>%
head(15)
# dem10
#reorder factor to allow for descending bars
dem10 <- dem10 %>%
mutate(zipname = fct_reorder(zipname, demtotal))
#export to file
write_csv(dem10, "output/dem10.csv")
#chart it out
d <- ggplot(dem10, aes(zipname, demtotal)) + geom_col(fill = "darkblue") + coord_flip() +
theme_minimal()
#add extra elements to the chart and convert to ggplotly
d2 <- d + labs(title="GA Runoffs: Top ActBlue zip codes",
# subtitle = "A subtitle",
caption = "Source: FEC, Bloomberg Analysis",
x ="", y = "") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_y_continuous(labels=dollar)
d2
# dd <- ggplotly(d2)
#
# dd_nomenu <- dd %>% config(displayModeBar = FALSE)
# dd_nomenu
#
# #save as embeddable format
# # htmlwidgets::saveWidget(frameableWidget(dd), 'demtopzip_plt.html')
# htmlwidgets::saveWidget(frameableWidget(dd_nomenu), 'demtopzip_chart_nm.html')
#
# #save as RDS object
# saveRDS(dd_nomenu, "zip_data/demtopzip_chart_nm.rds")
Top Zips for Democratic Advantage (ActBlue)
#pull out top zips for the dems
dem10_adv <- zipcompare %>%
filter(winner == "D") %>%
arrange(desc(advantage)) %>%
head(15)
#reorder factor to allow for descending bars
dem10_adv <- dem10_adv %>%
mutate(zipname = fct_reorder(zipname, advantage))
#export to file
write_csv(dem10_adv, "output/dem10_adv.csv")
#chart it out
d <- ggplot(dem10_adv, aes(zipname, advantage)) + geom_col(fill = "darkblue") + coord_flip() +
theme_minimal()
#add extra elements to the chart and convert to ggplotly
d2 <- d + labs(title="GA Runoffs: Top Zips Where Grassroots Dems Outraised GOP",
subtitle = "(bars show advantage in dollars raised)",
caption = "Source: FEC, Bloomberg Analysis",
x ="", y = "") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.subtitle = element_text(hjust = 0.5)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_y_continuous(labels=dollar)
d2
Top Zips for Republican Total Contributions (WinRed)
#pull out top 10 zips for the gop
gop10 <- zipcompare %>%
arrange(desc(goptotal)) %>%
head(15)
# gop10
#reorder factor to allow for descending bars
gop10 <- gop10 %>%
mutate(zipname = fct_reorder(zipname, goptotal))
#export to file
write_csv(gop10, "output/gop10.csv")
#chart it out
p <- ggplot(gop10, aes(zipname, goptotal)) + geom_col(fill = "darkred") + coord_flip() +
theme_minimal()
#add titles and other extras
p2 <- p + labs(title="Ga Senate Runoffs: Top WinRed zip codes",
# subtitle = "A subtitle",
caption = "Source: FEC, Bloomberg Analysis",
x ="", y = "") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_y_continuous(labels=dollar)
p2
# pp <- ggplotly(p2)
#
# pp
#
# pp_nomenu <- pp %>% config(displayModeBar = FALSE)
# pp_nomenu
#
# #save as embeddable format
# # htmlwidgets::saveWidget(frameableWidget(pp), 'goptopzip_plt.html')
# htmlwidgets::saveWidget(frameableWidget(pp_nomenu), 'goptopzip_plt_nm.html')
#save as RDS object
# saveRDS(pp_nomenu, "zip_data/goptopzip_plt_nm.rds")
Top Zips for Republican Advantage (WinRed)
#pull out top zips
gop10_adv <- zipcompare %>%
filter(winner == "R") %>%
arrange(desc(advantage)) %>%
head(15)
#reorder factor to allow for descending bars
gop10_adv <- gop10_adv %>%
mutate(zipname = fct_reorder(zipname, advantage))
#export to file
write_csv(gop10_adv, "output/gop10_adv.csv")
#chart it out
d <- ggplot(gop10_adv, aes(zipname, advantage)) + geom_col(fill = "darkred") + coord_flip() +
theme_minimal()
#add extra elements to the chart and convert to ggplotly
d2 <- d + labs(title="GA Runoffs: Top Zips Where Grassroots GOP Outraised Dems",
subtitle = "(bars show advantage in dollars raised)",
caption = "Source: FEC, Bloomberg Analysis",
x ="", y = "") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.subtitle = element_text(hjust = 0.5)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_y_continuous(labels=dollar)
d2
#bring in comparison table created above
zipcompare <- readRDS("zip_data/zipcompare.rds")
head(zipcompare)
| zip_code | demtotal | goptotal | winner | advantage | city | state | zipname | num_returns | total_agi_value | avg_agi | avg_agi_rank |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 10024 | 461941.6 | 21277.16 | D | 440664.4 | New York | NY | 10024 (New York, NY) | 30410 | 9984610 | 328333.1 | 147 |
| 10025 | 432180.5 | 23949.47 | D | 408231.1 | New York | NY | 10025 (New York, NY) | 45610 | 6826320 | 149667.2 | 846 |
| 94114 | 413873.9 | 4116.66 | D | 409757.2 | San Francisco | CA | 94114 (San Francisco, CA) | 20360 | 4324445 | 212399.1 | 377 |
| 94110 | 405725.0 | 2744.16 | D | 402980.9 | San Francisco | CA | 94110 (San Francisco, CA) | 38770 | 4590850 | 118412.4 | 1460 |
| 10023 | 395714.1 | 53242.10 | D | 342472.0 | New York | NY | 10023 (New York, NY) | 34070 | 11766656 | 345367.1 | 125 |
| 94117 | 328673.8 | 2513.33 | D | 326160.5 | San Francisco | CA | 94117 (San Francisco, CA) | 23140 | 3644629 | 157503.4 | 748 |
names(zipcompare)
## [1] "zip_code" "demtotal" "goptotal" "winner"
## [5] "advantage" "city" "state" "zipname"
## [9] "num_returns" "total_agi_value" "avg_agi" "avg_agi_rank"
zipcompare$GEOID <- zipcompare$zip_code
#remove any negative values
zipcompare <- zipcompare %>%
filter(demtotal >= 0,
goptotal >= 0)
zipcompare <- zipcompare %>%
filter(!str_detect(GEOID, "^99"),
!str_detect(GEOID, "^96"),
!str_detect(GEOID, "^006"),
!str_detect(GEOID, "^007"),
!str_detect(GEOID, "^009")
)
#### get zip code lat/long points from census gazeteer file
zip_points <- read_csv("zip_data/zip_points.csv",
col_types = cols(ALAND = col_skip(),
ALAND_SQMI = col_skip(), AWATER = col_skip(),
AWATER_SQMI = col_skip()))
colnames(zip_points) <- c("GEOID", "lat", "lon")
#join data
zip_map <- inner_join(zipcompare, zip_points)
## Joining, by = "GEOID"
zip_map$winner <- as.factor(zip_map$winner)
#add dollar formatting
zip_map$demdisplay <- dollar(zip_map$demtotal)
zip_map$gopdisplay <- dollar(zip_map$goptotal)
National zipcode map of Dem vs. GOP advantage in contributions
#### MAPPING POINTS ##### ---------------------------------------
factpal <- colorFactor(c("blue","red"), zip_map$winner)
#labels
labs1 <- lapply(seq(nrow(zip_map)), function(i) {
paste0( '<p>', 'Zip code: ', '<strong>', zip_map[i, "GEOID"], '</strong></p>',
'<p></p>',
"Democrats: ", zip_map[i, "demdisplay"],
'<p></p>',
"Republicans: ", zip_map[i, "gopdisplay"]
)
})
m1 <- leaflet(zip_map) %>%
addTiles() %>%
addCircles(lng = ~lon, lat = ~lat, weight = .4,
stroke = FALSE, fillOpacity = .25,
radius = ~sqrt(advantage) * 300,
fillColor = ~factpal(winner),
label = lapply(labs1, HTML)
) %>%
addControl("ActBlue vs. WinRed - GA Senate candidate contributions by zip code", position = "topright")
# %>%
# setView(-96, 37.8, zoom=4)
m1
#save to frameable file for CMS
htmlwidgets::saveWidget(frameableWidget(m1),'gasenate_actblue_vs_winred_zippoints.html')
# save as rds object
saveRDS(m1, "savedmap_zipcompare.rds")
Atlanta-area-only zipcode map of Dem vs. GOP advantage in contributions
#filter for just GA
zip_map <- zip_map %>%
filter(state == "GA")
factpal <- colorFactor(c("blue","red"), zip_map$winner)
#labels
labs1 <- lapply(seq(nrow(zip_map)), function(i) {
paste0( '<p>', 'Zip code: ', '<strong>', zip_map[i, "GEOID"], '</strong></p>',
'<p></p>',
"Democrats: ", zip_map[i, "demdisplay"],
'<p></p>',
"Republicans: ", zip_map[i, "gopdisplay"]
)
})
m2 <- leaflet(zip_map) %>%
addTiles() %>%
addCircles(lng = ~lon, lat = ~lat, weight = .4,
stroke = FALSE, fillOpacity = .25,
radius = ~sqrt(advantage) * 20,
fillColor = ~factpal(winner),
label = lapply(labs1, HTML)
) %>%
addControl("ActBlue vs. WinRed - GA Senate candidate contributions by zip code", position = "topright") %>%
setView(-84.3880, 33.7490, zoom = 9)
m2
#save to frameable file for CMS
htmlwidgets::saveWidget(frameableWidget(m2),'gasenate_actblue_vs_winred_zippoints_ATLONLY.html')
# save as rds object
saveRDS(m2, "savedmap_zipcompare_ATLONLY.rds")
#### top zips for each party
t_gop <- zipcompare %>%
select(zip_code, total = goptotal) %>%
mutate(party = "R") %>%
arrange(desc(total)) %>%
head(250)
t_dem <- zipcompare %>%
select(zip_code, total = demtotal) %>%
mutate(party = "D") %>%
arrange(desc(total)) %>%
head(250)
#combine
t_both <- bind_rows(t_dem, t_gop)
t_both %>% write_xlsx("output/t_both.xlsx")